home *** CD-ROM | disk | FTP | other *** search
/ PCDisk Magazine Disks / PCDisk Magazine - Disk 3.img / MAKESCRN.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-08-01  |  16.1 KB  |  202 lines
  1. 10  '"MAKESCREEN." , OPPENHEIMER SOFTWARE. COPYRIGHT 1984
  2. 50  ONERRORGOTO20000
  3. 100  READ S.I0%:START%=1+S.I0%:S.DIM%=START%+50:DIM S.X%(S.DIM%),S.Y%(S.DIM%),S.LEN%(S.DIM%),S.FL%(S.DIM%),S.FI$(S.DIM%),S.DA$(S.DIM%),S.LR$(S.DIM%),S.HR$(S.DIM%),S.DEF$(S.DIM%),S.HELP$(S.DIM%),S.CHAR%(255):SEG=&HB800:RAM.BUF=&H4000
  4. 210  DEF SEG=&HB000:POKE &HFFF,&HFE:IF PEEK(&HFFF)=&HFE THEN SEG=&HB000
  5. 900  GOSUB59050:GOSUB19000:COLOR15:LOCATE5,30:PRINT"** M A K E S C R E E N**":LOCATE7,34:PRINT"Screen Generator":LOCATE9,32:PRINT"Oppenheimer Software":LOCATE11,35:PRINT"Copyright 1984
  6. 920  LOCATE13,23:PRINT"Press F4 to clear screen and continue...":O.Y%=4:O.X%=2:LOCATE4,2
  7. 1000  GOSUB 10300:COLOR,0,0:LOCATE,,1,3,2:GOSUB 10000:IF S.EXIT%THEN DEF SEG=SEG:BSAVE"screen.tmp",0,RAM.BUF:CLS:LOCATE ,,1,12,13:COLOR 7,0
  8. 1010  IF S.EXIT% THEN KEY ON:KEY 1,"LIST":KEY 2,"RUN"+CHR$(13):KEY 3,"LOAD"+CHR$(34):KEY 4,"SAVE"+CHR$(34):KEY 5,"CONT"+CHR$(13):KEY 6,","+CHR$(34)+"LPT1:":KEY 7,"TRON"+CHR$(13):KEY 8,"TROFF"+CHR$(13):KEY 9,"KEY":KEY 10,"SCREEN 0,0,0"+CHR$(13):NEW:END
  9. 1030  IF COMMAND%THEN 2000
  10. 1040  IF(POS(0)<2 OR POS(0)>79)OR(CSRLIN<4 OR CSRLIN>18)THEN BEEP:GOTO 1000
  11. 1050  COLOR 15:PRINT IN$;:IF POS(0)>78 AND CSRLIN<23 THEN LOCATE CSRLIN+1,2
  12. 1070  X%=POS(0):Y%=CSRLIN:GOTO 2900
  13. 2000  ON COMMAND%GOTO 2010,2020,2030,2040,2050,2060,2070,2080,2090,2100,2110,2200,2130
  14. 2001  STOP
  15. 2010  X%=2:Y%=4:GOTO2900
  16. 2020  IFCSRLIN<5THENBEEP:GOTO1000 ELSEX%=POS(0):Y%=CSRLIN-1:GOTO2900
  17. 2030  IFPOS(0)<3THENBEEP:GOTO1000 ELSEX%=POS(0)-1:Y%=CSRLIN:GOTO2900
  18. 2040  IFPOS(0)>78THENBEEP:GOTO1000 ELSEX%=POS(0)+1:Y%=CSRLIN:GOTO2900
  19. 2050  X%=79:Y%=18:GOTO2900
  20. 2060  IFCSRLIN>17THENBEEP:GOTO1000 ELSEX%=POS(0):Y%=CSRLIN+1:GOTO2900
  21. 2070  IFPOS(0)<2THENBEEP:GOTO1000 ELSEX%=POS(0)+(POS(0)>2):Y%=CSRLIN:LOCATEY%,X%:PRINT" ";:GOTO2900
  22. 2080  FI%=1:GOSUB40000:IFS.EXIT%THEN2010 ELSEDEFSEG=SEG:BSAVES.DA$(FI%),0,RAM.BUF:GOSUB19000:GOTO2010
  23. 2090  FI%=2:GOSUB40000:IFS.EXIT%THEN2010 ELSEDEFSEG=SEG:BLOADS.DA$(FI%),0:GOSUB19000:GOSUB18000:GOTO2010
  24. 2100  DEFSEG=SEG:BSAVE"screen.tmp",0,RAM.BUF:GOSUB19000:GOTO4000
  25. 2110  GOSUB41240:GOTO2010
  26. 2120  DEFSEG=SEG:BLOAD"screen.tmp",0:GOSUB19000:GOSUB18000:GOTO2010
  27. 2130  FORL%=1TO25:LPRINT"|";:FORC%=2TO79:TMP%=SCREEN(L%,C%):IFTMP%=196ORTMP%=205THENTMP%=95
  28. 2150  LPRINTCHR$(TMP%);:NEXTC%:LPRINT"|":NEXTL%:LPRINT"++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++":LPRINT"Row  Line Len Prompt  Help Message":FORI%=START%TOSTART%+50
  29. 2153  IFS.X%(I%)=0THEN2180 ELSEXX$="\ \":LPRINTUSING"## ## ## "+XX$+" "+XX$;S.X%(I%),S.Y%(I%),S.LEN%(I%),S.FI$(I%),S.HELP$(I%)
  30. 2155  IFS.FL%(I%)AND16THENLPRINT,"Input will be converted to upper case
  31. 2156  IFS.FL%(I%)AND32THENLPRINT,"Field will be erased after data entry
  32. 2157  IFS.FL%(I%)AND64THENLPRINT,"Input will be Function keys F";S.LR$(I%);" through F";S.HR$(I%)
  33. 2158  IFS.FL%(I%)AND128THENLPRINT,"Input will be a numeric interger
  34. 2159  IFS.FL%(I%)AND256THENLPRINT,"Input will be a numeric floaring point ($$) value
  35. 2160  IFS.FL%(I%)AND512THENLPRINT,"Input will be between ";S.LR$(I%);" and ";S.HR$(I%)
  36. 2161  IFS.FL%(I%)AND1024THENLPRINT,"Input may not be blank (at least 1 character entered)
  37. 2162  IFS.FL%(I%)AND2048THENLPRINT,"Input must fully fill the input field
  38. 2163  IFS.FL%(I%)AND4096THENLPRINT,"Input must be either ";:S.LR$=S.LR$(I%):S.HR$=S.HR$(I%):S.TMP%=1ELSE2168
  39. 2164  S.TMP1%=INSTR(S.TMP%,S.LR$,S.HR$):IFS.TMP1%THENTMP$=TMP$+MID$(S.LR$,S.TMP%,S.TMP1%-S.TMP%)+" or ":S.TMP%=S.TMP1%+1:GOTO2164
  40. 2165  LPRINTLEFT$(TMP$,LEN(TMP$)-4)
  41. 2168  IFS.FL%(I%)AND8192THENLPRINT,"Input must be a date in the MMDDYY format
  42. 2169  IFS.FL%(I%)AND16384THENLPRINT,"This is a display only field-no input accepted
  43. 2179  IFS.DEF$(I%)<>""ANDS.DEF$(I%)<>SPACE$(S.LEN%(I%))THENLPRINT,"Default:";S.DEF$(I%)
  44. 2180  NEXTI%:LPRINTCHR$(12):GOTO2900
  45. 2200  FI%=21:GOSUB40000:LOCATE2,20:TEMP$=S.DA$(FI%):GOSUB6000:S.DA$(FI%)=TEMP$:S.DA$(FI%)=SPACE$((40-LEN(S.DA$(FI%)))/2)+S.DA$(FI%):PRINTS.DA$(FI%):GOTO2010
  46. 2900  LOCATEY%,X%,1,3,2:COLOR14:PRINTCHR$(SCREEN(Y%,X%));:LOCATEY%,X%,1,3,2:O.X%=X%:O.Y%=Y%:LOCATE24,30:PRINT"Line ";Y%;" Col ";X%;"  ";:LOCATEY%,X%:GOTO1000
  47. 4000  FI%=19:GOSUB40000:IFS.EXIT%THEN1000 ELSECLOSE2:OPEN S.DA$(FI%) FOR OUTPUT AS 2
  48. 4005  FI%=20:GOSUB40000:IFS.EXIT%THEN4000 ELSELL=VAL(S.DA$(FI%))
  49. 4010  FORI%=START%TOSTART%+50:S.X%(I%)=0:S.Y%(I%)=0:S.LEN%(I%)=0:S.FL%(I%)=0:S.FI$(I%)="":S.DA$(I%)="":S.LR$(I%)="":S.HR$(I%)="":S.DEF$(I%)="":NEXT:F%=0:FORL%=4TO18:FORC%=2TO78:C1%=C%:TMP%=SCREEN(L%,C%):IFFLAG%=0ANDTMP%=32THEN4900
  50. 4140  IF(TMP%<48ORTMP%>57)ANDFLAG%=0THENS.ER$="Field w/o Field number":GOSUB41250:GOTO2120
  51. 4150  FLAG%=1:F.NO$="":WHILEINSTR(1,"1234567890",CHR$(SCREEN(L%,C%)))ANDC%<79:F.NO$=F.NO$+CHR$(SCREEN(L%,C%)):C%=C%+1:WEND:F.NO.END$="":WHILEINSTR(1," :.-)>",CHR$(SCREEN(L%,C%)))ANDC%<79:F.NO.END$=F.NO.END$+CHR$(SCREEN(L%,C%)):C%=C%+1:WEND
  52. 4170  F.PROMPT$="":LOCATE 4,4,3,0,7:WHILE CHR$(SCREEN(L%,C%))<>"_"AND C%<79:F.PROMPT$=F.PROMPT$+CHR$(SCREEN(L%,C%)):C%=C%+1:WEND:F.INPUT$="":WHILE CHR$(SCREEN(L%,C%))="_"AND C%<79:F.INPUT$=F.INPUT$+CHR$(SCREEN(L%,C%)):C%=C%+1:WEND
  53. 4200  F%=START%+VAL(F.NO$):S.X%(F%)=C1%:S.Y%(F%)=L%:S.FI$(F%)=F.NO$+F.NO.END$+F.PROMPT$:S.LEN%(F%)=LEN(F.INPUT$)
  54. 4900  FLAG%=0:NEXTC%:NEXTL%:I0%=0:FORI%=START%TOSTART%+50:I0%=I0%+SGN(S.X%(I%)):NEXT:PRINT#2,LL,"DATA",I0%-(S.DA$(21)<>SPACE$(LEN(S.DA$(21)))):LL=LL+10
  55. 4940  IFS.DA$(21)<>SPACE$(LEN(S.DA$(21)))THENPRINT#2,LL;" DATA 20,2,0,16384,";CHR$(34)+S.DA$(21)+CHR$(34);",0,0,0,0":LL=LL+10
  56. 5000  LOCATE21,1:PRINTSPACE$(78):FORI%=START%TOSTART%+50:IFS.X%(I%)=0THEN5900
  57. 5010  LOCATES.Y%(I%),S.X%(I%):COLOR0,7:PRINTS.FI$(I%);:COLOR7,0:FLAG%=0:FI%=3:GOSUB40000:IFS.EXIT%THEN5920
  58. 5030  FLAG%=0:TMP=VAL(S.DA$(FI%)):IFTMP=2THENFLAG%=128 ELSEIFTMP=3THENFLAG%=256 ELSEIFTMP=4THENFLAG%=8192 ELSEIFTMP=5THENFLAG%=64
  59. 5035  IFFLAG%AND8192THENS.LEN%(I%)=6
  60. 5040  IFFLAG%=0THENFI%=4:GOSUB40000:IFS.EXIT%THEN5920 ELSEIFS.DA$(FI%)="Y"THENFLAG%=16
  61. 5050  IFFLAG%AND-17THEN5100
  62. 5060  FI%=5:GOSUB40000:IFS.DA$(FI%)="N"THEN5100 ELSEIFS.EXIT%THEN5920
  63. 5070  FI%=6:GOSUB40000:IFS.EXIT%THEN5060 ELSETMP$=S.DA$(FI%)
  64. 5080  TEMP$=TMP$:GOSUB6000:TMP$=TEMP$:FLAG%=FLAG%OR4096:S.LR$(I%)=TMP$:S.HR$(I%)="/
  65. 5100  FI%=7:GOSUB40000:IFS.EXIT%THEN5920 ELSEIFS.DA$(FI%)="Y"THENFLAG%=FLAG%OR32
  66. 5110  IFS.DA$(3)<>"5"THEN5200
  67. 5120  FI%=8:GOSUB40000:IFS.EXIT%THEN5920 ELSES.LR$(I%)=S.DA$(FI%)
  68. 5130  FI%=9:GOSUB40000:IFS.EXIT%THEN5920 ELSES.HR$(I%)=S.DA$(FI%)
  69. 5200  IFFLAG%AND4160THEN5300 ELSEFI%=10:GOSUB40000:IFS.EXIT%THEN5920 ELSEIFS.DA$(FI%)="N"THEN5300
  70. 5220  FI%=11:S.LEN%(FI%)=S.LEN%(I%):GOSUB 40000:IF S.EXIT%THEN 5920 ELSE S.LR$(I%)=S.DA$(FI%)
  71. 5230  FLAG%=FLAG%OR 512:FI%=12:S.LEN%(FI%)=S.LEN%(I%):GOSUB 40000:IF S.EXIT%THEN 5920 ELSE S.HR$(I%)=S.DA$(FI%)
  72. 5300  FI%=13:GOSUB 40000:IF S.EXIT%THEN 5920 ELSE TMP$=S.DA$(FI%):IF TMP$="1"THEN FLAG%=FLAG%OR 2048 ELSE IF TMP$="2"THEN FLAG%=FLAG%OR 1024
  73. 5310  FI%=14:GOSUB 40000:S.HELP$(I%)=S.DA$(FI%):FI%=15:S.LEN%(FI%)=S.LEN%(I%):GOSUB 40000:S.DEF$(I%)=S.DA$(FI%):TMP$=CHR$(34):QU$=TMP$:IF FLAG%AND 384 THEN TMP$="
  74. 5405  TEMP$=S.DEF$(I%):IFS.FLAG%AND8192THENIFTEMP$<>SPACE$(LEN(TEMP$))THENS.DEF$(I%)=LEFT$(TEMP$,2)+MID$(TEMP$,4,2)+MID$(TEMP$,7,2)
  75. 5410  TEMP$=S.FI$(I%):GOSUB6000:S.FI$(I%)=TEMP$:TEMP$=S.LR$(I%):GOSUB6000:S.LR$(I%)=TEMP$:TEMP$=S.HR$(I%):GOSUB6000:S.HR$(I%)=TEMP$:TEMP$=S.DEF$(I%):GOSUB6000:S.DEF$(I%)=TEMP$:TEMP$=S.HELP$(I%):GOSUB6000:S.HELP$(I%)=TEMP$
  76. 5510  LL=LL+10:PRINT#2,LL;" DATA";S.X%(I%);",";S.Y%(I%);",";S.LEN%(I%);",";FLAG%;",";QU$;S.FI$(I%);QU$;",";TMP$;S.LR$(I%);TMP$;",";TMP$;S.HR$(I%);TMP$;",";TMP$;S.DEF$(I%);TMP$;",";QU$;S.HELP$(I%):S.FL%(I%)=FLAG%
  77. 5900  IF S.X%(I%)>0 THEN LOCATE S.Y%(I%),S.X%(I%):COLOR 7,0:PRINT S.FI$(I%)+" ";
  78. 5910  NEXTI%
  79. 5920  LOCATES.BOT%,2:COLOR0:PRINTSPACE$(78);:COLOR7:CLOSE2:GOSUB19000:GOTO2010
  80. 6000  WHILELEFT$(TEMP$,1)=" ":TEMP$=MID$(TEMP$,2):WEND:WHILERIGHT$(TEMP$,1)=" ":TEMP$=LEFT$(TEMP$,LEN(TEMP$)-1):WEND:RETURN
  81. 10000  COMMAND%=0:DISPLAY%=0:S.EXIT%=0:IN$=INKEY$:IFIN$=""THEN10000 ELSEIFIN$=CHR$(27)THENS.EXIT%=-1:RETURN
  82. 10100  IFLEN(IN$)=2ORIN$=CHR$(8)THENIN$=MID$(IN$+CHR$(8),2,1):COMMAND%=INSTR(1,COMMAND$,IN$):IFCOMMAND%=0THENBEEP:GOTO1000ELSERETURN
  83. 10200  DISPLAY%=INSTR(1,DISPLAY$,IN$):IFDISPLAY%=0THENBEEP:GOTO10000ELSERETURN
  84. 10300  RETURN
  85. 18000  TMP$="":FORC%=16TO54:TMP$=TMP$+CHR$(SCREEN(2,C%)):NEXT
  86. 18020  IFLEFT$(TMP$,1)=" "THENTMP$=MID$(TMP$,2):GOTO18020
  87. 18030  IFRIGHT$(TMP$,1)=" "THENTMP$=LEFT$(TMP$,LEN(TMP$)-1):GOTO18030
  88. 18040  S.DA$(21)=SPACE$((40-LEN(TMP$))/2)+TMP$:RETURN
  89. 19000  LOCATE23,1:COLOR14,1:PRINT"F1";:COLOR0,14:PRINT" Save";:COLOR0,1:PRINT" ";:COLOR14,1:PRINT"F2";:COLOR0,14:PRINT" Load";:COLOR0,1:PRINT" ";:COLOR14,1:PRINT"F3";:COLOR0,14:PRINT" Edit";:COLOR0,1:PRINT" ";
  90. 19030  COLOR14,1:PRINT"F4";:COLOR0,14:PRINT" Clear";:COLOR0,1:PRINT" ";:COLOR14,1:PRINT"F5";:COLOR0,14:PRINT" Title";:COLOR0,1:PRINT" ";:COLOR14,1:PRINT"F6";:COLOR0,14:PRINT" Print";:COLOR0,1:PRINT" ";
  91. 19060  COLOR14,1:PRINT"<ESC>";:COLOR0,14:PRINT" Exit to BASIC";:COLOR7,0:PRINT"  ";:RETURN
  92. 20000  S.ER$="":IFERL>=2130ANDERL<=2190THENS.ER$="PRINTER FAILURE
  93. 20010  IFERR=53THENS.ER$="FILE NOT FOUND-TRY AGAIN
  94. 20020  IFERR=70THENS.ER$="WRITE PROTECTED DISK-REMOVE TAB, THEN TRY AGAIN
  95. 20030  IFERR=71THENS.ER$="DISK IS NOT READY-CHECK DISK DOOR, THEN TRY AGAIN
  96. 20040  IFERR=72THENS.ER$="DISK (the floppy-not the drive) MAY BE BAD??? 
  97. 20050  IFERR=61THENS.ER$="DISK IS FULL-PUT IN NEW DISK, THEN RETRY
  98. 20070  IFS.ER$=""THENS.ER$="BASIC ERROR "+STR$(ERR)+" at line "+STR$(ERL)+"-not expected
  99. 20090  GOSUB41250:FORDELAY=1TO2000:NEXTDELAY:LOCATES.BOT%-3,2:PRINTSPACE$(78);:RESUME2010
  100. 40000  LOCATE,,0,9:LOCATES.BOT%,72:COLOR0,7:PRINT"F10";:COLOR3,0:PRINT" help";:FORS.TMP%=2TO79:IFSCREEN(S.BOT%-3,S.TMP%,1)<>5THEN40010 ELSELOCATES.BOT%-3,S.TMP%:COLOR0:PRINT" ";:NEXT
  101. 40010  S.TMP%=FI%:FI%=ABS(FI%):S.X%=S.X%(FI%):S.Y%=FNS.Y%(FI%):S.FL%=S.FL%(FI%):S.FI$=S.FI$(FI%):S.LEN%=S.LEN%(FI%):S.OFFSET%=S.X%+LEN(S.FI$):S.RESTART%=0:S.EXIT%=0:S.HE$="
  102. 40030  S.LR$=S.LR$(FI%):S.HR$=S.HR$(FI%):S.DEF$=S.DEF$(FI%):S.DA$="":IFS.FORCE$<>""ANDRIGHT$(S.FORCE$,1)<>CHR$(13)THENS.FORCE$=S.FORCE$+CHR$(13)
  103. 40040  WHILEASC(S.DEF$+"A")=32:S.DEF$=MID$(S.DEF$,2):WEND:WHILERIGHT$("A"+S.DEF$,1)=" ":S.DEF$=LEFT$(S.DEF$,LEN(S.DEF$)-1):WEND:IFS.DEF$<>""THENS.DEF$=LEFT$(S.DEF$,S.LEN%)
  104. 40060  IFS.FL%AND16384ORS.TMP%<0THENS.LEN%=0:S.DISP$=S.DA$(FI%):GOSUB41150:RETURN
  105. 40080  IFS.FL%AND128THENS.HE$=" -a number
  106. 40090  IFS.FL%AND256THENS.HE$=S.HE$+" -a dollar value
  107. 40100  IFS.FL%AND64THENS.HE$=S.HE$+" -function keys "+S.LR$+" through "+S.HR$
  108. 40110  IFS.FL%AND512THENS.HE$=S.HE$+" -between "+S.LR$+" and "+S.HR$
  109. 40120  IF(S.FL%AND4096)=0THEN40160 ELSES.TMP%=1:S.HE$=" -either 
  110. 40130  S.TMP1%=INSTR(S.TMP%,S.LR$,S.HR$):IFS.TMP1%THENS.HE$=S.HE$+MID$(S.LR$,S.TMP%,S.TMP1%-S.TMP%)+" or ":S.TMP%=S.TMP1%+1:GOTO40130
  111. 40150  S.HE$=LEFT$(S.HE$,LEN(S.HE$)-4)
  112. 40160  IFS.FL%AND8192THENS.HE$=S.HE$+" -a date in MMDDYY format
  113. 40170  IFS.FL%AND1024THENS.HE$=S.HE$+" -not blank
  114. 40180  IFS.FL%AND2048THENS.HE$=S.HE$+" -fully entered
  115. 40190  IFS.DEF$<>""THENS.HE$=S.HE$+" -press<RETURN>for default
  116. 40200  IFS.HE$<>""THENS.HE$="Enter"+S.HE$
  117. 40210  S.TMP%=LEN(S.HE$):IFS.TMP%>78THENWHILE(MID$(S.HE$,S.TMP%,1)<>"-"):S.TMP%=S.TMP%-1:WEND:S.HE$=LEFT$(S.HE$,S.TMP%-1):GOTO40210
  118. 40230  GOSUB41060:GOSUB41130:S.ENTER%=1:S.INPUT$="":LOCATES.Y%,S.X%+LEN(S.FI$(FI%))+1:IFS.DEF$<>""THENGOSUB40540
  119. 40255  COLOR3:LOCATE2,2:PRINT"SCREENMAKER";:WHILES.ENTER%<=S.LEN%
  120. 40280  S.CURSOR$=MID$(LEFT$(S.DEF$+S.BLK$,1)+S.BLK$,1-(S.ENTER%>1),1)
  121. 40320  LOCATES.Y%,S.ENTER%+S.OFFSET%:COLOR22:PRINTS.CURSOR$;:COLOR0:S.TMP$=INKEY$:IFS.FORCE$<>""THENS.TMP$=LEFT$(S.FORCE$,1):S.FORCE$=MID$(S.FORCE$,2)
  122. 40325  IFS.TMP$=""THEN40320
  123. 40340  IFS.DEF$<>""ANDS.ENTER%=1ANDS.TMP$<>S.CR$THENGOSUB41130
  124. 40360  IFS.ER%THENLOCATES.BOT%-3,2:PRINTSPACE$(77);:S.ER%=0
  125. 40390  S.TMP%=LEN(S.TMP$):IFS.TMP%<>1THENS.TMP$=CHR$(255AND(100+ASC(RIGHT$(S.TMP$,1)))):GOTO40430
  126. 40410  IF(S.FL%AND64)ANDS.TMP$<>CHR$(27)THENS.ER$="Use only the function keys listed below":GOTO41080
  127. 40430  S.TMP%=ASC(S.TMP$):IF(S.FL%AND16)AND(S.CHAR%(S.TMP%)=9)THENS.TMP%=S.TMP%-32:S.TMP$=CHR$(S.TMP%)
  128. 40440  ONS.CHAR%(S.TMP%)GOTO40480,40510,40570,40630,40670,40690,40740,40810,40670,41080
  129. 40480  IFS.FL%AND384THENS.ER$="spaces cant be used in numeric fields":GOTO41080
  130. 40490  GOTO40630
  131. 40510  IFS.FL%AND128THENS.ER$="no decimal can be used here":GOTO41080
  132. 40520  IFS.FL%AND256AND(INSTR(S.INPUT$,".")<>0)THENS.ER$="a number may only have 1 decimal!":GOTO41080
  133. 40530  GOTO40630
  134. 40540  LOCATES.Y%,S.OFFSET%+1:COLOR6:PRINTS.DEF$;:COLOR7:RETURN
  135. 40570  IFS.ENTER%=1THENS.ER$="field is empty - nothing to delete!":GOTO41080
  136. 40580  S.ENTER%=S.ENTER%-1:S.INPUT$=LEFT$(S.INPUT$,S.ENTER%-1):LOCATES.Y%,S.OFFSET%+S.ENTER%:COLOR7:PRINTS.BLK$;S.BLK$;:IFS.DEF$<>""ANDS.ENTER%=1THENGOSUB40540
  137. 40610  GOTO40280
  138. 40630  IFS.TMP$="-"ANDS.ENTER%<>1AND(S.FL%AND384)THENS.ER$=" minus sign must be in first position":GOTO41080
  139. 40650  LOCATES.Y%,S.OFFSET%+S.ENTER%:S.ENTER%=S.ENTER%+1:COLOR6:PRINTS.TMP$;:S.INPUT$=S.INPUT$+S.TMP$:GOTO40830
  140. 40670  IFS.FL%AND8576THENS.ER$="only numbers and decimal are valid here":GOTO41080 ELSE40630
  141. 40690  IFS.ENTER%=1ANDS.DEF$<>""THENS.INPUT$=S.DEF$:S.ENTER%=99:GOTO40830
  142. 40700  IF((S.FL%AND1024)ANDS.ENTER%=1)THENS.ER$="please do leave field blank":GOTO41080
  143. 40710  IFS.FL%AND2048THENS.ER$="please fill field - dont press RETURN":GOTO41080
  144. 40720  S.ENTER%=99:GOTO40830
  145. 40740  IFS.TMP%=168THENLOCATES.BOT%-3,2:COLOR5:PRINTS.HELP$(FI%);SPACE$(77-LEN(S.HELP$(FI%)));:COLOR7:GOTO40280
  146. 40760  IF(S.FL%AND64)=0THENS.ER$="function keys not used here":GOTO41080
  147. 40770  IF(S.TMP%-110<ASC(RIGHT$(S.LR$,1)))OR(S.TMP%-110>ASC(RIGHT$(S.HR$,1)))THENS.ER$="wrong function key pressed":GOTO41080
  148. 40780  GOSUB41220:S.INPUT%=S.TMP%-158:COLOR7:GOTO41150
  149. 40810  S.EXIT%=-1:S.ENTER%=99
  150. 40830  WEND:IFS.EXIT%THENGOSUB41200:RETURN
  151. 40840  IF S.EXIT% THEN GOSUB 41200:COLOR 7:GOTO 41045
  152. 40860  IF(S.FL%AND8192)=0THEN40900 ELSES.MM%=VAL(LEFT$(S.INPUT$,2)):S.DD%=VAL(MID$(S.INPUT$,3,2)):S.YY%=VAL(RIGHT$(S.INPUT$,2))
  153. 40870  S.RESTART%=1:S.ER$=" bad month number":IFS.MM%<1ORS.MM%>12THEN41080
  154. 40880  S.ER$=" wrong number of days in month":IFS.DD%>28+ASC(MID$("CACBCBCCBCBC",S.MM%))-64ORS.DD%<1THEN41080 ELSES.ER$="
  155. 40900  S.RESTART%=1:IFS.FL%AND4096ANDINSTR(1,S.LR$,S.INPUT$+S.HR$)=0THENS.ER$=" entry did not match allowed choices":GOTO41080
  156. 40910  S.RESTART%=1:IFS.INPUT$<>""AND(S.FL%AND512)<>0AND(((S.FL%AND384)AND(VAL(S.INPUT$)<VAL(S.LR$)ORVAL(S.INPUT$)>VAL(S.HR$)))OR((S.FL%AND384)=0)AND(S.INPUT$<S.LR$ORS.INPUT$>S.HR$))THENS.ER$="input was not within limits":GOTO41080
  157. 40920  IFS.FL%AND128THENS.INPUT$=STR$(VAL(S.INPUT$)):S.TMP%=LEN(S.INPUT$):IFS.INPUT$=SPACE$(S.TMP%)THENS.INPUT$=SPACE$(S.TMP%-1)+"0
  158. 40940  IF S.FL%AND 256 THEN S.INPUT#=VAL(S.INPUT$):S.INPUT$="0"+MID$(STR$(FIX(S.INPUT#*100)),2):S.TMP%=LEN(S.INPUT$):S.INPUT$=LEFT$("-",-(S.INPUT#<0))+MID$(STR$(VAL(LEFT$(S.INPUT$,S.TMP%-2))),2)+"."+RIGHT$(S.INPUT$,2)
  159. 40960  IFS.FL%AND384THENS.INPUT$=RIGHT$(SPACE$(20)+S.INPUT$,S.LEN%)
  160. 40980  IF(S.FL%AND384)=0THENS.INPUT$=S.INPUT$+SPACE$(S.LEN%-LEN(S.INPUT$))
  161. 41000  S.DISP$=S.INPUT$:IFS.FL%AND8192THENS.DISP$=LEFT$(S.INPUT$,2)+"/"+MID$(S.INPUT$,3,2)+"/"+RIGHT$(S.INPUT$,2)
  162. 41040  S.DA$(FI%)=S.INPUT$:GOSUB 41150
  163. 41045  LOCATE S.BOT%-2,2:PRINT SPACE$(78);:LOCATE S.BOT%-3,2:PRINT SPACE$(78);:RETURN
  164. 41060  LOCATES.BOT%-2,1:COLOR6,0,0:PRINTS.VRT$:LOCATES.BOT%-2,2:COLOR2:PRINTS.HE$;SPACE$(78-LEN(S.HE$));:COLOR7:PRINT"";:RETURN
  165. 41080  S.ER$="BAD KEY[S] PRESSED "+S.ER$:GOSUB41250:ONS.RESTART%+1GOTO40280,40000
  166. 41100  IF(S.FL%AND256)=0THEN41110 ELSEX=VAL(S.INPUT$):L%=S.LEN%(FI%):IFABS(X)<0.01THENX=0
  167. 41102  X$=STR$(X):X%=INSTR(1,X$,"."):IFX%>0ANDX%<LEN(X$)-2THENX$=LEFT$(X$,X%+2)
  168. 41104  IFX%=0THENX$=X$+".00
  169. 41106  IFMID$(X$,LEN(X$)-1,1)="."THENX$=X$+"0
  170. 41108  S.INPUT$=RIGHT$(SPACE$(10)+X$,L%):S.INPUT=X
  171. 41110  S.Y%=FNS.Y%(FI%):S.X%=S.X%(FI%):S.DEF$(FI%)=S.DA$(FI%):S.DISP$=S.DA$(FI%):IF(S.FL%(FI%)AND8192)=0THEN41300 ELSES.DISP$=LEFT$(S.DISP$,2)+"/"+MID$(S.DISP$,3,2)+"/"+RIGHT$(S.DISP$,2):GOTO41310
  172. 41130  LOCATES.Y%,S.X%:COLOR7:PRINTS.FI$(FI%);" ";:PRINTSTRING$(S.LEN%,176);SPACE$((S.FL%AND8192)/4096);:RETURN
  173. 41150  IFS.FL%AND32THENLOCATES.Y%,S.X%:COLOR0:PRINTSPACE$(LEN(S.FI$(FI%))+1+S.LEN%(FI%));:COLOR3:RETURN
  174. 41170  LOCATES.Y%,S.X%:COLOR3:PRINTS.FI$(FI%);" ";S.DISP$;:RETURN
  175. 41200  LOCATEFNS.Y%(FI%),S.X%(FI%):COLOR0:PRINTSPACE$(LEN(S.FI$(FI%)));
  176. 41220  LOCATEFNS.Y%(FI%),S.X%(FI%)+LEN(S.FI$(FI%))+1:COLOR0:PRINTSPACE$(S.LEN%(FI%));:RETURN
  177. 41240  FORS.TMP%=14TO75:LOCATE2,S.TMP%:PRINT" ":NEXT:FORS.TMP%=1TOS.BOT%-8:LOCATE3+S.TMP%,2:PRINTSPACE$(78);:NEXT:RETURN
  178. 41250  LOCATES.BOT%-3,2:COLOR20:PRINT"ERROR>";:COLOR4:BEEP:PRINTS.ER$;SPACE$(68-LEN(S.ER$));:COLOR7:S.ER%=LEN(S.ER$):S.ER$="":RETURN
  179. 41300  REM
  180. 41310  FORFI%=LAYOUT%(CHAN%,1)TOLAYOUT%(CHAN%,4):LOCATES.Y%(FI%),S.X%(FI%):COLOR0:PRINTSPACE$(LEN(S.FI$(FI%))+3+S.LEN%(FI%));:NEXT:COLOR3:RETURN
  181. 59050  S.TMP$="":S.TMP%=0:S.ENTER%=0:S.FL%=0:S.ER$="":S.CR$=CHR$(13):S.BOT%=23:FOR FI%=1 TO S.I0%:READ S.X%(FI%),S.Y%(FI%),S.LEN%(FI%),S.FL$,S.FI$(FI%),S.LR$(FI%),S.HR$(FI%),S.DEF$(FI%),S.HELP$(FI%):S.DA$(FI%)="
  182. 59060  IF S.HELP$(FI%)="" THEN S.HELP$(FI%)="No Help Available for this field"
  183. 59110  IFLEFT$(S.FL$,1)<>"!"THENS.FL%(FI%)=VAL(S.FL$) ELSEFORS.TMP%=2TOLEN(S.FL$):S.FL%(FI%)=S.FL%(FI%)OR((2^(S.TMP%-2))*-(MID$(S.FL$,S.TMP%,1)="1")):NEXT
  184. 59120  NEXT:FORS.TMP%=1TO255:S.CHAR%(S.TMP%)=10:NEXT:S.CHAR%(32)=1:FORS.TMP%=33TO122:S.CHAR%(S.TMP%)=5:NEXT:S.CHAR%(46)=2:S.CHAR%(8)=3:FORS.TMP%=48TO57:S.CHAR%(S.TMP%)=4:NEXT:S.CHAR%(45)=4:FORS.TMP%=97TO122:S.CHAR%(S.TMP%)=9:NEXT
  185. 59220  FORS.TMP%=159TO168:S.CHAR%(S.TMP%)=7:NEXT:S.CHAR%(13)=6:S.CHAR%(27)=8:S.DATE$=MID$("JanFebMarAprMayJunJulAugSepOctNovDec",(VAL(LEFT$(DATE$,2))-1)*3+1,3)+MID$(DATE$,3)
  186. 59260  S.TMP$=CHR$(205):FORS.TMP%=1TO78:S.MID$=S.MID$+CHR$(196):S.TOP$=S.TOP$+S.TMP$:NEXT:S.BOT$=CHR$(212)+S.TOP$+CHR$(190):S.TOP$=CHR$(213)+S.TOP$+CHR$(184):S.MID$=CHR$(195)+S.MID$+CHR$(180):S.VRT$=CHR$(179):S.BLK$=CHR$(176)
  187. 59310  WIDTH 80:LOCATE 1,1:KEY OFF:COLOR 6,0,0:CLS:PRINT S.TOP$:FOR S.TMP%=2 TO S.BOT%-1:LOCATE S.TMP%,1:PRINT S.VRT$;:LOCATE S.TMP%,80:PRINT S.VRT$;:NEXT:LOCATE S.BOT%-1,1:PRINT S.BOT$;:LOCATE 3,1:PRINT S.MID$:LOCATE S.BOT%-4,1:PRINT S.MID$
  188. 59330  FORS.TMP%=1TO10:KEYS.TMP%,"":NEXT:DEFFNS.Y%(FI%)=(S.Y%(FI%)*-SGN(S.Y%(FI%)>0))+((S.BOT%+S.Y%(FI%))*-SGN(S.Y%(FI%)<0)):DISPLAY$="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890-= !@#$%^&*()_+<>.,?/:;
  189. 59510  COMMAND$="GHKMOP"+CHR$(8)+";<=>?@":RETURN
  190. 60000  DATA21:DATA2,24,15,1056,"Enter file name to SAVE to or <ESC> to abort","","","MAKESCRN.SCN","This file name will hold this screen image
  191. 60200  DATA2,24,15,1056,"Enter file name to LOAD to or <ESC> to abort","","","MAKESCRN.SCN","This is the image to return to the screen
  192. 60300  DATA2,24,1,1184,"Field type:1-Text,2-Integer,3-Dollar,4-Date,5-Function key,6-Display only",1,6,1,"This defines the type of data to be entered here
  193. 60310  DATA2,24,1,5168,"Convert input to upper case? (Y/N)",Y/N/,/,"","Is the text entry to be uppercase only?":DATA2,24,1,5168,"Multiple choice input? (Y/N)",Y/N/,/,"","Is the text entry to be restricted to certain entries?
  194. 60330  DATA2,24,30,32,"Enter choices with a '/' after EACH ",0,0,"","Choices should look like:Y/y/N/n/":DATA2,24,1,5168,"Erase field after input is complete? (Y/N)",Y/N/,/,"","Should the prompt and data be erased?
  195. 60370  DATA 2,24,1,1184,"Enter STARTing function key",1,9,"","Enter the first allowed function key number":DATA 2,24,1,1184,"Enter ENDing function key",1,9,"","Enter the last allowed function key number
  196. 60390  DATA 2,24,1,5168,"Is the input limited to a range of values ?",Y/N/,/,"","Is the text entry to be within a range of values?":DATA 2,24,5,1056,"Enter STARTing value",0,0,0,"Enter the first allowed value
  197. 60410  DATA 2,24,5,1056,"Enter ENDing value",0,0,0,"Enter the last allowed value":DATA 2,24,1,1184,"Entry requirement:1-Full,2-Partial,3-Optional",1,3,1,"Data field :Full-is filled, PARTIAL- is not blank, OPTIONAL-may be blank
  198. 60430  DATA2,24,65,32,"Help message",0,0,"","Enter help message to be displayed if user presses 'F10'":DATA2,24,20,32,"Default:","","","","Enter optional default input":DATA0,0,0,0,"",0,0,0,0:DATA0,0,0,0,"",0,0,0,0:DATA0,0,0,0,"",0,0,0,0
  199. 60480  DATA 2,24,14,1056,"Enter file name to SAVE data statements to or <ESC> to abort","","","SCREEN.DAT","This file name will hold the data statements
  200. 60490  DATA2,24,5,1184,"Enter Starting line number for data statements",1,64000,60000,"Enter the line number where the data statements being produced should appear
  201. 60500  DATA2,24,40,32,"Enter Screen title","","","","Enter the title to appear at the top of the screen
  202.